home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOOLPAS2 / TFILES.PAS < prev    next >
Pascal/Delphi Source File  |  1990-04-08  |  3KB  |  133 lines
  1.  
  2. (*
  3.  * adirs - find all directories in a subdirectory tree
  4.  *
  5.  * Author: S.H.Smith, 5-Apr-86 (16-sep-87)
  6.  *
  7.  *)
  8.  
  9. uses DOS, MDOSIO, MINICRT, TOOLS;
  10.  
  11. var
  12.    fix:  text;
  13.    buf:  array[1..$8000] of byte;
  14.  
  15.    nfiles:  longint;
  16.    totalsz: longint;
  17.    itime:   real;
  18.  
  19. const
  20.    max_time = 1.5;
  21.  
  22. (* ------------------------------------------------- *)
  23. procedure testfile(dir,fname: pathstr);
  24. var
  25.    fd:         dos_handle;
  26.    filesize:   longint;
  27.    slow:       boolean;
  28.    n:          word;
  29.    started:    real;
  30.    initial:    real;
  31.    elapsed:    real;
  32.    now:        real;
  33.    speed:      real;
  34.  
  35. begin
  36.    if (dir = '\') and (fname = 'FIX.BAT') then
  37.       exit;
  38.  
  39.    fd := dos_open(dir+fname,open_read);
  40.    if fd = dos_error then
  41.       exit;
  42.  
  43.    inc(nfiles);
  44.    elapsed := get_time - itime;
  45.    if elapsed <> 0 then
  46.       write(fname:16,' - ',
  47.          nfiles:5,' files, ',
  48.          totalsz/1048576.0:7:2,' meg, ',
  49.          elapsed:6:1,' sec, ',
  50.          totalsz/elapsed/1024.0:6:1,' k/s - ');
  51.  
  52.    slow := false;
  53.  
  54.    initial := get_time;
  55.    now := initial;
  56.    filesize := 0;
  57.  
  58.    repeat
  59.       started := now;
  60.       n := dos_read(fd,buf,sizeof(buf));
  61.       filesize := filesize + n;
  62.       now := get_time;
  63.       elapsed := now-started;
  64.       slow := elapsed > max_time;
  65.    until slow or (n < sizeof(buf));
  66.  
  67.    dos_close(fd);
  68.  
  69.    filesize := (filesize + 511) and $7FFFFE00;
  70.    totalsz := totalsz + filesize;
  71.  
  72.    if slow then
  73.    begin
  74.       if length(dir) > 1 then
  75.          dec(dir[0]);
  76.  
  77.       write(fix,'call ');
  78.       if paramstr(2) = '' then
  79.          write(fix,'makebad')
  80.       else
  81.          write(fix,paramstr(2));
  82.       writeln(fix,' ',fname,' ',dir);
  83.       flush(fix);
  84.  
  85.       writeln('Slow!'^G);
  86.    end
  87.    else
  88.       write('Ok      '^M);
  89. end;
  90.  
  91. (* ------------------------------------------------- *)
  92. procedure getfiles(dir: dirstr);
  93. var
  94.    DirInfo:       SearchRec;
  95. begin
  96.    clreol;
  97.    writeln(dir);
  98.    if dir = '\BAD\' then exit;
  99.  
  100.    FindFirst(dir+'*.*',Anyfile,DirInfo);
  101.    while (DosError = 0) do
  102.    begin
  103.       if ((DirInfo.Attr and Directory) = 0) then
  104.          testfile(dir,DirInfo.Name);
  105.       FindNext(DirInfo);
  106.    end;
  107.  
  108.    FindFirst(dir+'*.*',Anyfile,DirInfo);
  109.    while (DosError = 0) do
  110.    begin
  111.       if ((DirInfo.Attr and Directory) <> 0) then
  112.          if (DirInfo.name[1] <> '.') then
  113.             getfiles(dir+DirInfo.Name+'\');
  114.       FindNext(DirInfo);
  115.    end;
  116. end;
  117.  
  118. (* ------------------------------------------------- *)
  119. begin
  120.    {clrscr;}
  121.    gotoxy(1,25);
  122.    assign(output,'');
  123.    rewrite(output);
  124.    assign(fix,'\FIX.BAT');
  125.    rewrite(fix);
  126.    nfiles := 0;
  127.    totalsz := 0;
  128.    itime := get_time;
  129.    getfiles(paramstr(1)+'\');
  130.    close(fix);
  131. end.
  132.  
  133.